home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / sync / testFileSyncMon1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-02-27  |  2.8 KB  |  107 lines
  1. unit testFileSyncMon1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, GpFileSyncMonitors, StdCtrls;
  8.  
  9. type
  10.   TfrmMain = class(TForm)
  11.     GpFileMutexMonitor1: TGpFileMutexMonitor;
  12.     grpMutexMon: TGroupBox;
  13.     lblMutex: TLabel;
  14.     btnAcquire: TButton;
  15.     btnRelease: TButton;
  16.     lbMutex: TListBox;
  17.     grpGroupMon: TGroupBox;
  18.     lblGroup: TLabel;
  19.     btnJoinGroup: TButton;
  20.     btnLeaveGroup: TButton;
  21.     lbGroup: TListBox;
  22.     GpFileGroupMonitor1: TGpFileGroupMonitor;
  23.     procedure GpFileMutexMonitor1Acquired(Sender: TObject);
  24.     procedure GpFileMutexMonitor1Released(Sender: TObject);
  25.     procedure btnAcquireClick(Sender: TObject);
  26.     procedure btnReleaseClick(Sender: TObject);
  27.     procedure GpFileGroupMonitor1Empty(Sender: TObject);
  28.     procedure GpFileGroupMonitor1NotEmpty(Sender: TObject);
  29.     procedure btnJoinGroupClick(Sender: TObject);
  30.     procedure btnLeaveGroupClick(Sender: TObject);
  31.   private
  32.     procedure Log(lb: TListBox; msg: string);
  33.   public
  34.   end;
  35.  
  36. var
  37.   frmMain: TfrmMain;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TfrmMain.GpFileMutexMonitor1Acquired(Sender: TObject);
  44. begin
  45.   lblMutex.Caption := '<Acquired>';
  46.   Log(lbMutex,'>Acquired');
  47. end; { TfrmMain.GpFileMutexMonitor1Acquired }
  48.  
  49. procedure TfrmMain.GpFileMutexMonitor1Released(Sender: TObject);
  50. begin
  51.   lblMutex.Caption := '>Released<';
  52.   Log(lbMutex,'>Released');
  53. end; { TfrmMain.GpFileMutexMonitor1Released }
  54.  
  55. procedure TfrmMain.Log(lb: TListBox; msg: string);
  56. begin
  57.   lb.ItemIndex := lb.Items.Add(msg);
  58. end; { TfrmMain.Log }
  59.  
  60. procedure TfrmMain.btnAcquireClick(Sender: TObject);
  61. begin
  62.   if GpFileMutexMonitor1.Acquire(1000) then
  63.     Log(lbMutex,'Acquired')
  64.   else
  65.     Log(lbMutex,'Not acquired');
  66. end; { TfrmMain.btnAcquireClick }
  67.  
  68. procedure TfrmMain.btnReleaseClick(Sender: TObject);
  69. begin
  70.   GpFileMutexMonitor1.Release;
  71.   Log(lbMutex,'Released');
  72. end; { TfrmMain.btnReleaseClick }
  73.  
  74. procedure TfrmMain.GpFileGroupMonitor1Empty(Sender: TObject);
  75. begin
  76.   lblGroup.Caption := '>Empty<';
  77.   Log(lbGroup,'>Empty');
  78. end; { TfrmMain.GpFileGroupMonitor1Empty }
  79.  
  80. procedure TfrmMain.GpFileGroupMonitor1NotEmpty(Sender: TObject);
  81. begin
  82.   lblGroup.Caption := '<Not empty>';
  83.   Log(lbGroup,'>Not empty');
  84. end; { TfrmMain.GpFileGroupMonitor1NotEmpty }
  85.  
  86. procedure TfrmMain.btnJoinGroupClick(Sender: TObject);
  87. var
  88.   isFirst: boolean;
  89. begin
  90.   if GpFileGroupMonitor1.Join(1000,isFirst) then
  91.     Log(lbGroup,'Joined, '+IntToStr(Ord(isFirst)))
  92.   else
  93.     Log(lbGroup,'Not joined');
  94. end; { TfrmMain.btnJoinGroupClick }
  95.  
  96. procedure TfrmMain.btnLeaveGroupClick(Sender: TObject);
  97. var
  98.   wasLast: boolean;
  99. begin
  100.   if GpFileGroupMonitor1.Leave(1000,wasLast) then
  101.     Log(lbGroup,'Left, '+IntToStr(Ord(wasLast)))
  102.   else
  103.     Log(lbGroup,'Not left');
  104. end; { TfrmMain.btnLeaveGroupClick }
  105.  
  106. end.
  107.